home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / HEAP_UTL / TPSTACK / TPSTACK.PAS < prev   
Pascal/Delphi Source File  |  1988-06-25  |  7KB  |  236 lines
  1. {$S-,R-,I-,B-,D-}
  2.  
  3. {*********************************************************}
  4. {*                   TPSTACK.PAS 1.00                    *}
  5. {*                by TurboPower Software                 *}
  6. {*********************************************************}
  7.  
  8. unit TpStack;
  9.   {-Unit for monitoring stack and heap usage}
  10.  
  11. interface
  12.  
  13. const
  14.   {If True, results are reported automatically at the end of the program. Set
  15.    to False if you want to display results in another manner.}
  16.   ReportStackUsage : Boolean = True;
  17.  
  18. var
  19.   {The following variables, like the two procedures that follow, are interfaced
  20.    solely for the purpose of displaying results. You should never alter any of
  21.    these variables.}
  22.   OurSS : Word;              {value of SS register when program began}
  23.   InitialSP : Word;          {value of SP register when program began}
  24.   LowestSP : Word;           {lowest value for SP register}
  25.   HeapHigh : Pointer;        {highest address pointed to by HeapPtr}
  26.  
  27. procedure CalcStackUsage(var StackUsage : Word; var HeapUsage : LongInt);
  28.   {-Calculate stack and heap usage}
  29.  
  30. procedure ShowStackUsage;
  31.   {-Display stack and heap usage information}
  32.  
  33. {The next two routines are interfaced in case you need or want to deinstall the
  34.  INT $8 handler temporarily, as you might when using the Exec procedure in the
  35.  DOS unit.}
  36.  
  37. procedure InstallInt8;
  38.   {-Save INT $8 vector and install our ISR, if not already installed}
  39.  
  40. procedure RestoreInt8;
  41.   {-Restore the old INT $8 handler if our ISR is installed}
  42.  
  43. {The following routine allows you to alter the rate at which samples are taken.
  44.  For it to have any effect, it must be preceded by a call to RestoreInt8 and
  45.  followed by a call to InstallInt8.}
  46.  
  47. procedure SetSampleRate(Rate : Word);
  48.   {-Set number of samples per second. Default is 1165, minimum is 18.}
  49.  
  50.   {==========================================================================}
  51.  
  52. implementation
  53.  
  54. type
  55.   SegOfs =                   {structure of a 32-bit pointer}
  56.     record
  57.       Offset, Segment : Word;
  58.     end;
  59. const
  60.   Int8Installed : Boolean = False;  {True if our INT $8 handler is installed}
  61.   DefaultRate = 1024;        {corresponds to 1165 samples/second}
  62. var
  63.   SaveInt8 : ^Pointer;       {pointer to original INT $8 vector}
  64.   SaveExitProc : Pointer;    {saved value for ExitProc}
  65.   Vectors : array[0..$FF] of Pointer absolute $0:$0;
  66.   Rate8253,
  67.   Counts,
  68.   CountsPerTick : Word;
  69.  
  70.   procedure IntsOff;
  71.     {-Turn off CPU interrupts}
  72.   inline($FA);
  73.  
  74.   procedure IntsOn;
  75.     {-Turn on CPU interrupts}
  76.   inline($FB);
  77.  
  78.   {$L TPSTACK.OBJ}
  79.  
  80.   procedure ActualSaveInt8;
  81.     {-Actually a pointer variable in CS}
  82.     external {TPSTACK} ;
  83.  
  84.   procedure Int8;
  85.     {-Interrupt service routine used to monitor stack and heap usage}
  86.     external {TPSTACK} ;
  87.  
  88.   procedure SetTimerRate(Rate : Word);
  89.     {-Program system 8253 timer number 0 to run at specified rate}
  90.   begin                      {SetTimerRate}
  91.     IntsOff;
  92.     Port[$43] := $36;
  93.     Port[$40] := Lo(Rate);
  94.     inline($EB/$00);         {null jump}
  95.     Port[$40] := Hi(Rate);
  96.     IntsOn;
  97.   end;                       {SetTimerRate}
  98.  
  99.   procedure InstallInt8;
  100.     {-Save INT $8 vector and install our ISR, if not already installed}
  101.   begin                      {InstallInt8}
  102.     {make sure we're not already installed, in case we are called twice.
  103.      if we don't do this check, SaveInt8 could get pointed to *our* ISR}
  104.     if not Int8Installed then begin
  105.       {save the current vector}
  106.       SaveInt8^ := Vectors[$8];
  107.  
  108.       {Set counts til next system timer tick}
  109.       Counts := 0;
  110.  
  111.       {Keep interrupts off}
  112.       IntsOff;
  113.  
  114.       {Take over the timer tick}
  115.       Vectors[$8] := @Int8;
  116.  
  117.       {Reprogram the timer to run at the new rate}
  118.       SetTimerRate(Rate8253);
  119.  
  120.       {restore interrupts}
  121.       IntsOn;
  122.  
  123.       {now we're installed}
  124.       Int8Installed := True;
  125.     end;
  126.   end;                       {InstallInt8}
  127.  
  128.   procedure RestoreInt8;
  129.     {-Restore the old INT $8 handler if our ISR is installed}
  130.   begin                      {RestoreInt8}
  131.     {if we're currently installed, then deinstall}
  132.     if Int8Installed then begin
  133.       {no more samples}
  134.       IntsOff;
  135.  
  136.       {Give back the timer interrupt}
  137.       Vectors[$8] := SaveInt8^;
  138.  
  139.       {Reprogram the clock to run at normal rate}
  140.       SetTimerRate(0);
  141.  
  142.       {Normal interrupts again}
  143.       IntsOn;
  144.  
  145.       {no longer installed}
  146.       Int8Installed := False;
  147.     end;
  148.   end;                       {RestoreInt8}
  149.  
  150.   procedure SetSampleRate(Rate : Word);
  151.     {-Set number of samples per second. Default is 1165, minimum is 18.}
  152.   var
  153.     Disable : Boolean;
  154.   begin                      {SetSampleRate}
  155.     if (Rate >= 18) then begin
  156.       {deactivate Int8 temporarily if necessary}
  157.       Disable := Int8Installed;
  158.       if Disable then
  159.         RestoreInt8;
  160.  
  161.       Rate8253 := LongInt($123400) div LongInt(Rate);
  162.       CountsPerTick := LongInt($10000) div LongInt(Rate8253);
  163.  
  164.       {reactivate Int8 if necessary}
  165.       if Disable then
  166.         InstallInt8;
  167.     end;
  168.   end;                       {SetSampleRate}
  169.  
  170.   procedure CalcStackUsage(var StackUsage : Word; var HeapUsage : LongInt);
  171.     {-Calculate stack and heap usage}
  172.   begin                      {CalcStackUsage}
  173.     {calculate stack usage}
  174.     StackUsage := InitialSP-LowestSP;
  175.  
  176.     {calculate heap usage}
  177.     HeapUsage :=
  178.       (LongInt(SegOfs(HeapHigh).Segment-SegOfs(HeapOrg).Segment) * 16) +
  179.        LongInt(SegOfs(HeapHigh).Offset-SegOfs(HeapOrg).Offset);
  180.   end;                       {CalcStackUsage}
  181.  
  182.   procedure ShowStackUsage;
  183.     {-Display stack and heap usage information}
  184.   var
  185.     StackUsage : Word;
  186.     HeapUsage : LongInt;
  187.   begin                      {ShowStackUsage}
  188.     {calculate stack and heap usage}
  189.     CalcStackUsage(StackUsage, HeapUsage);
  190.  
  191.     {show them}
  192.     WriteLn('Stack usage: ', StackUsage, ' bytes.');
  193.     WriteLn('Heap usage:  ', HeapUsage, ' bytes.');
  194.   end;                       {ShowStackUsage}
  195.  
  196.   {$F+}  {Don't forget that exit handlers are always called FAR!}
  197.   procedure OurExitProc;
  198.     {-Deinstalls our INT $8 handler and reports stack/heap usage}
  199.   begin                      {OurExitProc}
  200.     {restore ExitProc}
  201.     ExitProc := SaveExitProc;
  202.  
  203.     {restore INT $8}
  204.     RestoreInt8;
  205.  
  206.     {show results if desired}
  207.     if ReportStackUsage then
  208.       ShowStackUsage;
  209.   end;                       {OurExitProc}
  210.   {$F-}
  211.  
  212. begin                        {TpStack}
  213.   {initialize SaveInt8}
  214.   SaveInt8 := @ActualSaveInt8;
  215.  
  216.   {initialize Rate8253 and CountsPerTick}
  217.   SetSampleRate(DefaultRate);
  218.  
  219.   {save current value for SS}
  220.   OurSS := SSeg;
  221.  
  222.   {save current value of SP and account for the return address on the stack}
  223.   InitialSP := SPtr+SizeOf(Pointer);
  224.   LowestSP := InitialSP;
  225.  
  226.   {save current position of HeapPtr}
  227.   HeapHigh := HeapPtr;
  228.  
  229.   {install our ISR}
  230.   InstallInt8;
  231.  
  232.   {save ExitProc and install our exit handler}
  233.   SaveExitProc := ExitProc;
  234.   ExitProc := @OurExitProc;
  235. end.                         {TpStack}
  236.